home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / crypt / crypt.bas next >
BASIC Source File  |  1994-06-27  |  2KB  |  81 lines
  1. 'general section
  2. Declare Function GetPrivateProfileInt% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName$, ByVal nDefault%, ByVal lpFileName$)
  3. Declare Function GetPrivateProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName As Any, ByVal lpDefault$, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName$)
  4. Declare Function WritePrivateProfileString% Lib "Kernel" (ByVal lpApplicationName$, ByVal lpKeyName$, ByVal lpString$, ByVal lplFileName$)
  5.  
  6. 'Call the Crypt routine again the decrypt the Strg$.  Without the proper
  7. 'Pass$, you'll get garbage back.  The longer the password, the longer it
  8. 'takes to "number crunch" to figure out the password.
  9.  
  10. Dim Pass$
  11. Dim Strg$
  12. Dim H$
  13.  
  14. Sub Command1_Click ()
  15.     Pass$ = "PASSWORD"
  16.     Strg$ = "You won't crack this easily"
  17.  
  18.     Print "Original = "; Strg$
  19.     Call Crypt(Pass$, Strg$)
  20.  
  21.     Print "Encrypted = "; Strg$
  22.  
  23. 'When writing an encrypted password to a sequential access file like the
  24. 'INI files, you need to convert the resultant encrypted file to hex data.
  25. 'This is because you can end up with an encrypted password that contains
  26. 'characters which cannot be properly read using sequential access.  So,
  27. 'before saving your encrypted password, use this routine:
  28.  
  29. H$ = ""
  30. For i = 1 To Len(Strg$)
  31.    J$ = Hex$(Asc(Mid$(Strg$, i, 1)))
  32.    If Len(J$) = 1 Then J$ = "0" + J$
  33.    H$ = H$ + J$
  34. Next
  35.  
  36.    Print "Hex = "; H$
  37.  
  38. 'This will create a string like "0EF31105" or some such.  Save that to
  39. 'the INI file.
  40.  
  41. 'Store the LENGTH of the password string as 2 bytes and concatenate
  42.  
  43.    H$ = Format$(Len(H$), "00") + H$
  44.    x% = WritePrivateProfileString%("SECURITY", "PASSWORD", H$, "E:\PROJECT.INI")
  45.  
  46. End Sub
  47.  
  48. Sub Command2_Click ()
  49. 'To read it back in,
  50.   H$ = Space$(80)
  51.   x% = GetPrivateProfileString%("SECURITY", "PASSWORD", "PASSWORD", H$, Len(H$), "E:\PROJECT.INI")
  52.   Print "After INI read = "; H$
  53.  
  54.  'PASSWORD=160000000000000000
  55.  
  56.   H$ = Mid$(H$, 3, Val(Left$(H$, 2)))
  57.  
  58.   Print "Before hex conversion = "; H$
  59.  
  60. Strg$ = ""
  61. For i = 1 To Len(H$) Step 2
  62.    J$ = Mid$(H$, i, 2)
  63.    Strg$ = Strg$ + Chr$(Val("&H" + J$))
  64. Next
  65.    Print "After hex conversion = "; Strg$
  66.  
  67. 'Strg$ would then contain the encrypted string, which you can now
  68. 'decrypt.
  69.  
  70.     Call Crypt(Pass$, Strg$)
  71.     Print "Decrypted = "; Strg$
  72. End Sub
  73.  
  74. Sub Crypt (Pass$, Strg$)
  75.   a = 1
  76.   For i = 1 To Len(Strg$)
  77.      B = Asc(Mid$(Pass$, a, 1)): a = a + 1: If a > Len(Pass$) Then a = 1
  78.      Mid$(Strg$, i, 1) = Chr$(Asc(Mid$(Strg$, i, 1)) Xor B)
  79.   Next
  80. End Sub
  81.